home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Cream of the Crop 25
/
Cream of the Crop 25.iso
/
os2
/
lopbk505.zip
/
LBKMOD5.PPE
(
.txt
)
< prev
next >
Wrap
PCBoard Programming Language Executable
|
1997-03-25
|
10KB
|
641 lines
;------------------------------------------------------------------------------
; .ss.
; `²²'
; .,sS$Ss,,s$ .,sS$$$Ss. .,sS$Ss,,s$ .ss. .sSs.
; .d$$²^°²$$$$'.d$P²°^^²$P'.d$$²^°²$$$$'.$$$' .$$$²Sb,.
; $$$' .$$$' $$$²Sçsµ²' .$$$' .$$$'.$$$' .$$$' `$$b.
; $$$b,,d$$$' ,$$$b,....,s$$$$b,,d$$$'.$$$;.,$$$' ;$$$
; `²S$$S²²S$$S²°²S$$$$S²°°²S$$$$$$',$$S²°²S$S'.sS$$$P²'
; .sS²°$$$²²°"' d²°'
; .$$² .$$'
; $$$.,d$$'
; `²S$$S²'
;------------------------------------------------------------------------------
; P.P.L.X. 2.OO (C)1996 - Lone Runner / AEGiS CoRP'96
;------------------------------------------------------------------------------
; PPE 3.2O (Encryption type I) - Analysis ON - Postprocessing ON
;------------------------------------------------------------------------------
Boolean BOOLEAN001
Boolean BOOLEAN002
Boolean BOOLEAN003
Boolean BOOLEAN004
Boolean BOOLEAN005
Boolean BOOLEAN006
Date DATE001
Date DATE002
Integer INTEGER001
Integer INTEGER002
Integer INTEGER003
Real REAL001
Real REAL002
Real REAL003
String STRING001
String STRING002
String STRING003
String STRING004
String STRING005
Time TIME001
Time TIME002
Byte BYTE001
Byte BYTE002
Byte BYTE003
Byte BYTE004
Word WORD001
;------------------------------------------------------------------------------
BOOLEAN006 = 0
GetToken STRING001
If (Trim(STRING001, " ") == "") Then
PrintLn
PrintLn "@X0CLBKTMOD5 FATAL ERROR: INVALID COMMAND SEQUENCE!"
PrintLn
PrintLn "@X0APlease run LBKMOD5 from within LoopUtil!"
PrintLn
Goto LABEL021
Else
Select Case (STRING001)
Case "1"
BOOLEAN006 = 1
Case "2"
BOOLEAN006 = 0
Endif
End Select
:LABEL001
If (BOOLEAN005) Goto LABEL005
PrintLn
PrintLn " @X0F(@X09L@X0F)@X0Bocking Timetable"
PrintLn " @X0F(@X09D@X0F)@X0Bialing Template Timetable"
PrintLn " @X0F(@X09Q@X0F)@X0Buit to LoopUtil main"
PrintLn
STRING004 = ""
InputStr "Timetable to edit", STRING004, 14, 1, "LlDdQq", 2 + 4
STRING004 = Upper(STRING004)
Newline
Select Case (STRING004)
Case "Q", "R"
BOOLEAN005 = 1
Goto LABEL021
Case "L"
STRING001 = PPEPath() + "LBKBACK.XXX"
If (Exist(PPEPath() + "LBKBACK.XXX")) Then
FOpen 2, STRING001, 0, 0
Else
PrintLn
PrintLn "@X0FPath & filename to LoopBack config file @X0E(Enter Below)"
InputStr "", STRING001, 12, 75, Mask_Path() + Mask_File(), 2 + 4
If (Exist(STRING001)) Goto LABEL002
PrintLn
PrintLn "@X0C" + STRING001 + " DOES NOT EXIST! @X0AReturning to LoopUtil Main..."
Goto LABEL021
Goto LABEL003
:LABEL002
FOpen 2, STRING001, 0, 0
Endif
:LABEL003
If (Ferr(2)) Then
BOOLEAN001 = 1
Else
BOOLEAN001 = 0
Endif
If (BOOLEAN001) Then
PrintLn
PrintLn "@X0CSorry, the @X0F" + STRING001 + " @X0Cfile is currently inaccessible..."
FClose 2
Return
Endif
FSeek 2, 884, 0
FRead 2, STRING002, 75
FClose 2
If (BOOLEAN006) Then
Gosub LABEL005
Else
Gosub LABEL008
Endif
BOOLEAN005 = 0
Case "D"
STRING005 = ""
InputText "Name of dialing template", STRING005, 10, 10
If (Strip(STRING005, " ") == "") Goto LABEL021
STRING002 = PPEPath() + Mid(STRING005, 1, 8) + ".TBL"
STRING002 = Strip(STRING002, " ")
If (BOOLEAN006) Then
Gosub LABEL005
Goto LABEL004
Endif
Gosub LABEL008
:LABEL004
BOOLEAN005 = 0
End Select
Goto LABEL001
:LABEL005
INTEGER001 = 0
INTEGER002 = 0
If (Exist(STRING002)) Goto LABEL006
PrintLn
PrintLn "@X0C" + STRING002 + " does not exist!"
Delay 9
Return
:LABEL006
INTEGER001 = FileInf(STRING002, 4)
INTEGER002 = (INTEGER001 - 43) / 25
PrintLn
PrintLn "@X0F File Size = " + String(INTEGER001) + " Number of Records = " + String(INTEGER002)
If (INTEGER002 <= 1) Then
PrintLn
PrintLn "@X0CTHERE MUST BE AT LEAST ONE RECORD PRESENT IN THE TIMETABLE FILE!"
PrintLn
Delay 18
Return
Endif
KbdChkOff
Rename STRING002, PPEPath() + String(PcbNode()) + "tt.$$$"
BOOLEAN001 = 1
FCreate 1, STRING002, 1, 2
If (Ferr(1)) Then
BOOLEAN001 = 1
Else
BOOLEAN001 = 0
Endif
If (BOOLEAN001) Then
PrintLn
PrintLn "@X0CSorry, the @X0F" + STRING002 + " @X0Cfile is currently inaccessible..."
FClose 1
Return
Endif
BOOLEAN001 = 1
FOpen 2, PPEPath() + String(PcbNode()) + "tt.$$$", 0, 3
If (Ferr(2)) Then
BOOLEAN001 = 1
Else
BOOLEAN001 = 0
Endif
If (BOOLEAN001) Then
PrintLn
PrintLn "@X0CSorry, the @X0F" + String(PcbNode()) + "tt.$$$ @X0Cfile is currently inaccessible..."
FClose 2
FClose 1
PrintLn
PrintLn "@X0ADeleting & renaming temporary files..."
Delete STRING002
Rename PPEPath() + String(PcbNode()) + "tt.$$$", STRING002
Return
Endif
BOOLEAN002 = 0
FSeek 1, 0, 0
FWrite 1, " LoopBack 5.05 TimeTable File " + Chr(13) + Chr(10) + Chr(32) + Chr(26) + Chr(0), 43
PrintLn
PrintLn "@X0FPacking TimeTable File: " + Upper(STRING002)
If (OnLocal()) Then
PrintLn
Print "@X0F0% @X07░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░ @X0F100%"
BYTE001 = GetY()
Else
PrintLn
Print "Purifying file... "
Endif
INTEGER001 = FileInf(PPEPath() + String(PcbNode()) + "tt.$$$", 4)
INTEGER002 = (INTEGER001 - 43) / 25
INTEGER003 = 1
While (INTEGER003 <= INTEGER002) Do
BOOLEAN002 = 0
BOOLEAN003 = 0
WORD001 = 0
DATE001 = 0
TIME001 = 0
DATE002 = 0
TIME002 = 0
FSeek 2, 43 + INTEGER003 * 25 - 25, 0
FRead 2, BOOLEAN003, 1
If (BOOLEAN003) Then
BOOLEAN002 = 1
Else
BOOLEAN002 = 0
Endif
If (BOOLEAN002) Goto LABEL007
FWrite 1, BOOLEAN003, 1
FRead 2, WORD001, 2
FWrite 1, WORD001, 2
FRead 2, DATE001, 2
FWrite 1, DATE001, 2
FRead 2, TIME001, 4
FWrite 1, TIME001, 4
FRead 2, DATE002, 2
FWrite 1, DATE002, 2
FRead 2, TIME002, 4
FWrite 1, TIME002, 4
FWrite 1, Space(10), 10
:LABEL007
If (OnLocal()) Then
Gosub LABEL018
Else
Gosub LABEL019
Endif
Inc INTEGER003
EndWhile
Color 7
FClose 1
FClose 2
PrintLn
PrintLn
PrintLn "@X0BDeleting temporary files..."
Delete PPEPath() + String(PcbNode()) + "tt.$$$"
PrintLn "@X0EChecking files..."
INTEGER001 = FileInf(STRING002, 4)
INTEGER002 = (INTEGER001 - 43) / 25
If (INTEGER002 < 1) Then
PrintLn
PrintLn "@X0C0 byte file! Recreating with a dummy record..."
FCreate 1, STRING002, 1, 2
FWrite 1, " LoopBack 5.05 TimeTable File " + Chr(13) + Chr(10) + Chr(32) + Chr(26) + Chr(0), 43
FWrite 1, 0, 1
FWrite 1, 0, 2
FWrite 1, 0, 2
FWrite 1, 0, 4
FWrite 1, 0, 2
FWrite 1, 0, 4
FWrite 1, Space(10), 10
FClose 1
PrintLn "@X0ANew timetable successfully created..."
Endif
PrintLn "@X0FTimetable successfully packed!"
Log "Timetable successfully packed!", 0
KbdChkOn
Return
:LABEL008
If (Exist(STRING002)) Goto LABEL009
PrintLn
PrintLn "@X0CCreating " + STRING002 + "..."
BOOLEAN001 = 0
FCreate 1, STRING002, 2, 2
If (Ferr(1)) Then
BOOLEAN001 = 1
Else
BOOLEAN001 = 0
Endif
If (BOOLEAN001) Then
PrintLn
PrintLn "@X0CSorry, the @X0F" + STRING002 + " @X0Cfile is currently inaccessible..."
FClose 1
Return
Endif
FWrite 1, " LoopBack 5.05 TimeTable File " + Chr(13) + Chr(10) + Chr(32) + Chr(26) + Chr(0), 43
FWrite 1, 0, 1
FWrite 1, 0, 2
FWrite 1, 0, 2
FWrite 1, 0, 4
FWrite 1, 0, 2
FWrite 1, 0, 4
FWrite 1, Space(10), 10
INTEGER001 = 68
Goto LABEL010
:LABEL009
PrintLn
PrintLn "@X0AReading " + STRING002 + "..."
BOOLEAN001 = 0
FOpen 1, STRING002, 2, 2
If (Ferr(1)) Then
BOOLEAN001 = 1
Else
BOOLEAN001 = 0
Endif
If (BOOLEAN001) Then
PrintLn
PrintLn "@X0CSorry, the @X0F" + STRING002 + " @X0Cfile is currently inaccessible..."
FClose 1
Return
Endif
INTEGER001 = FileInf(STRING002, 4)
:LABEL010
BOOLEAN002 = 0
INTEGER002 = (INTEGER001 - 43) / 25
INTEGER003 = 1
BOOLEAN004 = 1
While (!BOOLEAN002 && !Ferr(1)) Do
If (BOOLEAN004) Then
FSeek 1, 43 + 25 * INTEGER003 - 25, 0
FRead 1, BOOLEAN003, 1
FRead 1, WORD001, 2
FRead 1, DATE001, 2
FRead 1, TIME001, 4
FRead 1, DATE002, 2
FRead 1, TIME002, 4
Endif
PrintLn
PrintLn "TimeTable File: " + Upper(STRING002)
PrintLn
PrintLn "@X0ARecord #@X0F" + String(INTEGER003) + "@X0A of@X0F " + String(INTEGER002)
PrintLn
PrintLn " @X0F(@X09N@X0F)@X0Bode : @X0C" + String(WORD001)
Print " @X0F(@X09D@X0F)@X0Beleted : @X0C"
If (BOOLEAN003) Then
PrintLn "Yes"
Else
PrintLn "No "
Endif
PrintLn
PrintLn " @X0F(@X091@X0F)@X0B Date to Lock : @X0C" + String(DATE001)
PrintLn " @X0F(@X092@X0F)@X0B Time to Lock : @X0C" + String(TIME001)
PrintLn " @X0F(@X093@X0F)@X0B Date to Unlock : @X0C" + String(DATE002)
PrintLn " @X0F(@X094@X0F)@X0B Time to Unlock : @X0C" + String(TIME002)
PrintLn
PrintLn " @X0F(@X09+@X0F)@X0B Advance 1 record @X0F(@X09-@X0F)@X0B Retard 1 record"
PrintLn " @X0F(@X09J@X0F)@X0Bump to record @X0F(@X09A@X0F)@X0Bdd a record"
PrintLn " @X0F(@X09Q@X0F)@X0Buit to main"
PrintLn
STRING003 = "+"
InputStr "(H)elp, Enter command", STRING003, 15, 1, "+-NnDd1234JjAaQqRrHh", 2 + 4
Newline
STRING003 = Upper(STRING003)
If ((STRING003 == "Q") || (STRING003 == "R")) Then
BOOLEAN004 = 0
BOOLEAN002 = 1
Continue
Endif
If (STRING003 == "H") Then
Print "@PON@"
DispFile PPEPath() + "LBKTE", 1 + 4
Print "@POFF@"
Cls
BOOLEAN004 = 0
BOOLEAN002 = 0
Continue
Endif
If (STRING003 == "+") Then
If (INTEGER003 >= INTEGER002) Then
INTEGER003 = 1
Goto LABEL011
Endif
Inc INTEGER003
:LABEL011
BOOLEAN002 = 0
BOOLEAN004 = 1
Continue
Endif
If (STRING003 == "-") Then
If (INTEGER003 <= 1) Then
INTEGER003 = INTEGER002
Goto LABEL012
Endif
Dec INTEGER003
:LABEL012
BOOLEAN002 = 0
BOOLEAN004 = 1
Continue
Endif
If (STRING003 == "J") Then
InputInt "Record # to jump to", INTEGER003, 12
If ((INTEGER003 < 1) || (INTEGER003 > INTEGER002)) INTEGER003 = INTEGER002
BOOLEAN002 = 0
BOOLEAN004 = 1
Continue
Endif
If (STRING003 == "N") Then
InputInt "Node # that this lock pertains to (0=ALL)", WORD001, 12
Newline
If (WORD001 > MaxNode()) Then
STRING001 = YesChar()
InputYN "Node entered larger than maximum allowed. Continue", STRING001, 12
STRING001 = Upper(STRING001)
If (STRING001 == YesChar()) Then
FSeek 1, 43 + INTEGER003 * 25 - 24, 0
FWrite 1, WORD001, 2
Endif
Goto LABEL013
Endif
FSeek 1, 43 + INTEGER003 * 25 - 24, 0
FWrite 1, WORD001, 2
:LABEL013
BOOLEAN002 = 0
BOOLEAN004 = 1
Continue
Endif
If (STRING003 == "D") Then
If (BOOLEAN003) Then
BOOLEAN003 = 0
Goto LABEL014
Endif
BOOLEAN003 = 1
:LABEL014
FSeek 1, 43 + INTEGER003 * 25 - 25, 0
FWrite 1, BOOLEAN003, 1
BOOLEAN002 = 0
BOOLEAN004 = 1
Continue
Endif
If (STRING003 == "1") Then
InputDate "Date to lock", DATE001, 12
FSeek 1, 43 + INTEGER003 * 25 - 22, 0
FWrite 1, DATE001, 2
BOOLEAN002 = 0
BOOLEAN004 = 1
Continue
Endif
If (STRING003 == "2") Then
InputTime "Time to lock", TIME001, 12
FSeek 1, 43 + INTEGER003 * 25 - 20, 0
FWrite 1, TIME001, 4
BOOLEAN002 = 0
BOOLEAN004 = 1
Continue
Endif
If (STRING003 == "3") Then
InputDate "Date to unlock", DATE002, 12
FSeek 1, 43 + INTEGER003 * 25 - 16, 0
FWrite 1, DATE002, 2
BOOLEAN002 = 0
BOOLEAN004 = 1
Continue
Endif
If (STRING003 == "4") Then
InputTime "Time to unlock", TIME002, 12
FSeek 1, 43 + INTEGER003 * 25 - 14, 0
FWrite 1, TIME002, 4
BOOLEAN002 = 0
BOOLEAN004 = 1
Continue
Endif
If (STRING003 == "A") Then
BOOLEAN001 = 0
:LABEL015
If (BOOLEAN001) Goto LABEL017
InputInt "Node # that this lock pertains to (0=ALL)", WORD001, 12
FreshLine
If (WORD001 > MaxNode()) Then
PrintLn "@X0C Node out of range! Please enter a valid node number!"
BOOLEAN001 = 0
Goto LABEL016
Endif
BOOLEAN001 = 1
:LABEL016
Goto LABEL015
:LABEL017
FreshLine
InputDate "Date to lock", DATE001, 12
FreshLine
InputTime "Time to lock", TIME001, 12
FreshLine
InputDate "Date to unlock", DATE002, 12
FreshLine
InputTime "Time to unlock", TIME002, 12
PrintLn
PrintLn "@X0CCreating record..."
FSeek 1, 0, 2
FWrite 1, 0, 1
FWrite 1, WORD001, 2
FWrite 1, DATE001, 2
FWrite 1, TIME001, 4
FWrite 1, DATE002, 2
FWrite 1, TIME002, 4
FWrite 1, Space(10), 10
INTEGER001 = INTEGER001 + 25
Inc INTEGER002
INTEGER003 = INTEGER002
BOOLEAN002 = 0
BOOLEAN004 = 1
Endif
EndWhile
FClose 1
Return
:LABEL018
If (INTEGER003 == 1) BYTE004 = 0
If ((INTEGER003 <> 0) && (INTEGER002 <> 0)) Then
REAL002 = ToReal(INTEGER003) / ToReal(INTEGER002)
REAL003 = FmtReal(ToReal(35) * REAL002, 1, 0)
BYTE003 = ToByte(REAL003) - BYTE004
If (BYTE003 <> BYTE004) Then
Color 63
AnsiPos 4 + BYTE004, BYTE001
For BYTE004 = 1 To BYTE003
Print "░"
Next
BYTE004 = ToByte(REAL003)
REAL002 = FmtReal(REAL002 * 100, 1, 0)
BYTE003 = (43 - Len(String(REAL002) + "%")) / 2
Color 11
REAL003 = ToReal(BYTE001) - 1
AnsiPos BYTE003, ToByte(REAL003)
Print String(REAL002) + "%"
AnsiPos 45, BYTE001
Endif
Endif
Return
:LABEL019
If ((INTEGER003 <> 0) && (INTEGER002 <> 0)) Then
If (INTEGER003 == 1) Then
BYTE002 = 0
Goto LABEL020
Endif
BYTE002 = REAL001
:LABEL020
REAL001 = ToReal(INTEGER003) / ToReal(INTEGER002)
REAL001 = FmtReal(REAL001 * 100, 1, 0)
If (BYTE002 <> REAL001) Then
Backup Len(String(BYTE002) + "%")
Print String(REAL001) + "%"
Endif
Endif
Return
:LABEL021
End
;------------------------------------------------------------------------------
;
; Usage report (before postprocessing)
;
; ■ Statements used :
;
; 1 End
; 1 Cls
; 3 Color
; 102 Goto
; 104 Let
; 8 Print
; 70 PrintLn
; 61 If
; 1 DispFile
; 3 FCreate
; 4 FOpen
; 11 FClose
; 2 Delete
; 1 Log
; 3 InputStr
; 1 InputYN
; 3 InputInt
; 4 InputDate
; 4 InputTime
; 6 Gosub
; 11 Return
; 2 Delay
; 3 Inc
; 1 Dec
; 3 Newline
; 1 GetToken
; 1 InputText
; 1 KbdChkOn
; 1 KbdChkOff
; 3 AnsiPos
; 1 Backup
; 5 FreshLine
; 2 Rename
; 12 FSeek
; 13 FRead
; 38 FWrite
;
;
; ■ Functions used :
;
; 12 *
; 7 /
; 82 +
; 16 -
; 24 ==
; 6 <>
; 3 <
; 4 <=
; 3 >
; 3 >=
; 60 !
; 5 &&
; 4 ||
; 2 Len(
; 5 Upper()
; 1 Mid()
; 4 Space()
; 6 Ferr()
; 15 Chr()
; 1 Trim()
; 2 YesChar()
; 2 Strip()
; 19 String()
; 1 Mask_File()
; 1 Mask_Path()
; 9 PPEPath()
; 6 PcbNode()
; 2 OnLocal()
; 4 Exist()
; 1 GetY()
; 4 FileInf()
; 2 MaxNode()
; 3 ToByte()
; 6 ToReal()
; 3 FmtReal()
;
;------------------------------------------------------------------------------
;
; Analysis flags : No flag
;
;------------------------------------------------------------------------------
;
; Postprocessing report
;
; 1 For/Next
; 2 While/EndWhile
; 44 If/Then or If/Then/Else
; 2 Select Case
;
;------------------------------------------------------------------------------
; AEGiS Corp - Break the routines, code against the machines!
;------------------------------------------------------------------------------